home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 51 / Amiga Format CD51 (2000-03-10)(Future Publishing)(GB)[!][issue 2000-04].iso / -serious- / programming / e / powerd / source / pr2m.e < prev   
Text File  |  2000-01-27  |  5KB  |  218 lines
  1. PROC main()
  2.     DEF    args:PTR TO LONG,ra,
  3.             name[256]:STRING,dest[256]:STRING,
  4.             src:PTR TO CHAR,l,f=NIL
  5.     args:=['diskfont',NIL]:LONG
  6.     IF ra:=ReadArgs('SOURCE/A,SASC/S',args,NIL)
  7.         IF args[1]
  8.             StringF(name,'\s_pragmas.h',args[0])
  9.         ELSE
  10.             StringF(name,'\s_lib.h',args[0])
  11.         ENDIF
  12.         StringF(dest,'\s.m',args[0])
  13.         IF (l:=FileLength(name))>0
  14.             IF src:=New(l)
  15.                 IF f:=Open(name,OLDFILE)
  16.                     Read(f,src,l)
  17.                     Close(f)
  18.                 ELSE
  19.                     PrintFault(IoErr(),'pr2m')
  20.                 ENDIF
  21.                 IF f
  22.                     IF f:=Open(dest,NEWFILE)
  23.                         IF args[1] THEN xConvertSASC(f,src,l) ELSE xConvert(f,src,l)
  24.                         VfPrintf(f,'\n',NIL)
  25.                         Close(f)
  26.                     ELSE
  27.                         PrintFault(IoErr(),'pr2m')
  28.                     ENDIF
  29.                 ENDIF
  30.                 Dispose(src)
  31.             ENDIF
  32.         ELSE
  33.             PrintFault(IoErr(),'pr2m')
  34.         ENDIF
  35.         FreeArgs(ra)
  36.     ELSE
  37.         PrintFault(IoErr(),'pr2m')
  38.     ENDIF
  39. ENDPROC
  40.  
  41. PROC xConvert(f,src:PTR TO CHAR,l)
  42.     DEF    p=0,type,head=FALSE,name[256]:STRING,offset,i
  43.     WHILE p<l
  44.         WHILE src[p]<>"#"
  45.             p++
  46.             IF p>=l THEN RETURN
  47.             IF CtrlC() THEN RETURN
  48.         ENDWHILE
  49.         IF StrCmp('#pragma',src+p,7)
  50.             p:=xSkip(src,p+7,l)
  51.             p:=xGetName(name,src,p,l)
  52.             IF StrCmp('amicall',name)
  53.                 type:="AMIC"
  54.             ELSEIF StrCmp('tagcall',name)
  55.                 type:="TAGC"
  56.             ELSE
  57.                 PrintF('Only amicall and tagcall allowed (\s).\n',name)
  58.                 RETURN
  59.             ENDIF
  60.             IF type
  61.                 p:=xSkip(src,p,l)
  62.                 IF src[p]="("
  63.                     p:=xSkip(src,p+1,l)
  64.                     p:=xGetName(name,src,p,l)
  65.                     IF head=FALSE
  66.                         VfPrintf(f,'LIBRARY \s\n',[name])
  67.                         head:=TRUE
  68.                     ELSE
  69.                         VfPrintf(f,',\n',NIL)
  70.                     ENDIF
  71.                 ELSE
  72.                     PrintF('"(" expected.\n')
  73.                     RETURN
  74.                 ENDIF
  75.  
  76.                 p:=xSkip(src,p,l)
  77.                 IF src[p]=","
  78.                     p:=xSkip(src,p+1,l)
  79.                     p:=xGetName(name,src,p,l)
  80.                     IF (name[0]="0") AND (name[1]="x")
  81.                         name[0]:=" "
  82.                         name[1]:="$"
  83.                         offset:=Val(name)
  84.                     ELSE
  85.                         PrintF('"0x" expected.\n')
  86.                         RETURN
  87.                     ENDIF
  88.                 ELSE
  89.                     PrintF('"," expected.\n')
  90.                     RETURN
  91.                 ENDIF
  92.  
  93.                 p:=xSkip(src,p,l)
  94.                 IF src[p]=","
  95.                     p:=xSkip(src,p+1,l)
  96.                     p:=xGetName(name,src,p,l)
  97.                     VfPrintf(f,'\t\s',[name])
  98.                     i:=0
  99.                     WHILE src[p]<>")"
  100.                         name[i]:=src[p]
  101.                         IF p>=l THEN RETURN
  102.                         IF CtrlC() THEN RETURN
  103.                         i++
  104.                         p++
  105.                     ENDWHILE
  106.                     name[i]:="\0"
  107.                     VfPrintf(f,'\s',[name])
  108.                     IF type="AMIC"
  109.                         VfPrintf(f,')',NIL)
  110.                     ELSEIF type="TAGC"
  111.                         VfPrintf(f,':LIST OF TagItem)',NIL)
  112.                     ENDIF
  113.                 ELSE
  114.                     PrintF('"," expected.\n')
  115.                     RETURN
  116.                 ENDIF
  117.  
  118.                 VfPrintf(f,'(d0)=-\d',[offset])
  119.             ENDIF
  120.         ELSE
  121.             p++
  122.         ENDIF
  123.         IF CtrlC() THEN RETURN
  124.     ENDWHILE
  125. ENDPROC
  126.  
  127. PROC xConvertSASC(f,src:PTR TO CHAR,l)
  128.     DEF    p=0,type,head=FALSE,name[256]:STRING,offset,i,num[16]:STRING,n
  129.     WHILE p<l
  130.         WHILE src[p]<>"#"
  131.             p++
  132.             IF p>=l THEN RETURN
  133.             IF CtrlC() THEN RETURN
  134.         ENDWHILE
  135.         IF StrCmp('#pragma',src+p,7)
  136.             p:=xSkip(src,p+7,l)
  137.             p:=xGetName(name,src,p,l)
  138.             IF StrCmp('libcall',name)
  139.                 type:="LIBC"
  140.             ELSEIF StrCmp('tagcall',name)
  141.                 type:="TAGC"
  142.             ELSE
  143.                 PrintF('Only amicall and tagcall allowed (\s).\n',name)
  144.                 RETURN
  145.             ENDIF
  146.             IF type
  147.                 p:=xSkip(src,p,l)                        -> read base
  148.                 p:=xGetName(name,src,p,l)
  149.                 IF head=FALSE
  150.                     VfPrintf(f,'LIBRARY \s\n',[name])
  151.                     head:=TRUE
  152.                 ELSE
  153.                     VfPrintf(f,',\n',NIL)
  154.                 ENDIF
  155.  
  156.                 p:=xSkip(src,p,l)                        -> read function name
  157.                 p:=xGetName(name,src,p,l)
  158.                 VfPrintf(f,'\t\s(',[name])
  159.                 IF name[StrLen(name)-1]="A" THEN type:="TAGL"
  160.  
  161.                 p:=xSkip(src,p,l)                        -> read function offset
  162.                 p:=xGetName(name,src,p,l)
  163.                 StringF(num,'$\s',name)
  164.                 offset:=Val(num)
  165.  
  166.                 p:=xSkip(src,p,l)                        -> read arguments
  167.                 p:=xGetName(name,src,p,l)
  168.                 i:=StrLen(name)-3
  169.                 WHILE i>=0
  170.                     n:=name[i]
  171.                     StringF(num,'$\c',n)
  172.                     n:=Val(num)
  173.                     IF (n>=0) AND (n<=7)  THEN VfPrintf(f,'d\d',[n])
  174.                     IF (n>=8) AND (n<=15) THEN VfPrintf(f,'a\d',[n-8])
  175.                     i--
  176.                     IF CtrlC() THEN RETURN
  177.                 EXIT i<0
  178.                     VfPrintf(f,',',NIL)
  179.                 ENDWHILE
  180.                 IF type="LIBC"
  181.                     VfPrintf(f,')',NIL)
  182.                 ELSEIF type="TAGL"
  183.                     VfPrintf(f,':PTR TO TagItem)',NIL)
  184.                 ELSEIF type="TAGC"
  185.                     VfPrintf(f,':LIST OF TagItem)',NIL)
  186.                 ENDIF
  187.  
  188.                 VfPrintf(f,'(d0)=-\d',[offset])
  189.             ENDIF
  190.         ELSE
  191.             p++
  192.         ENDIF
  193.         IF CtrlC() THEN RETURN
  194.     ENDWHILE
  195. ENDPROC
  196.  
  197. PROC xSkip(src:PTR TO CHAR,p,l)
  198.     WHILE (src[p]=" ") OR (src[p]="\t")
  199.         p++
  200.         IF p>=l THEN RETURN l
  201.         IF CtrlC() THEN RETURN l
  202.     ENDWHILE
  203. ENDPROC p
  204.  
  205. PROC xGetName(dst:PTR TO CHAR,src:PTR TO CHAR,p,l)
  206.     DEF    i=0
  207.     WHILE ((src[p]>="A") AND (src[p]<="Z")) OR ((src[p]>="a") AND (src[p]<="z")) OR ((src[p]>="0") AND (src[p]<="9")) OR (src[p]="_")
  208.         dst[i]:=src[p]
  209.         IF p>=l THEN RETURN l
  210.         IF CtrlC() THEN RETURN l
  211.         i++
  212.         p++
  213.     ENDWHILE
  214.     dst[i]:="\0"
  215. ENDPROC p
  216.  
  217. CHAR '\n\n$VER:pr2m v1.0 by MarK (30.9.1999)\0\n\n'
  218.